home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / misc_lsp.arc / TRANS.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1987-08-24  |  3.2 KB  |  93 lines
  1. ; This program provides 2-dimesional and 3-dimensional coordinate translation
  2. ; rotation. Useful for rotating 3DFACE and 3DLINE entities.
  3.  
  4. ; NOTE !! All points must be 3d points of the form of (x y z).
  5.  
  6. (defun rotate (axis ang base p / pt xy)
  7.    (setq pt (mapcar '- p base))
  8.    (cond ((or (not ang) (not pt)) nil)
  9.          ((= "X" axis) 
  10.             (setq xy (calang (nth 1 pt) (nth 2 pt) ang))
  11.             (mapcar '+ (list (float (nth 0 pt)) (car xy) (cadr xy)) base)
  12.          )
  13.          ((= "Y" axis) 
  14.             (setq xy (calang (nth 2 pt) (nth 0 pt) ang))
  15.             (mapcar '+ (list (cadr xy) (float (nth 1 pt)) (car xy)) base)
  16.          )
  17.          ((= "Z" axis)
  18.             (setq xy (calang (nth 0 pt) (nth 1 pt) ang))
  19.             (mapcar '+ (list (car xy) (cadr xy) (float (nth 2 p))) base))
  20.    )
  21. )
  22.  
  23. (defun calang (x y ra / hyp vin)
  24.    (setq ra (* (/ ra 180.0) pi))
  25.    (setq hyp (sqrt (+ (* x x) (* y y))))
  26.    (setq vin (+ (atan y x) ra))
  27.    (setq x (* (cos vin) hyp))
  28.    (setq y (* (sin vin) hyp))
  29.    (list (if (< (abs x) 1e-12) 0.0 x)
  30.          (if (< (abs y) 1e-12) 0.0 y))
  31. )
  32.  
  33. (defun C:TRANS (/ ax bp el n sl ss v)
  34.    (setq n 0 sl 0)               ; initialize counter & entity count
  35.    (setq ss nil)                 ; set the selection-set to nil
  36.    (if (setq ss (ssget))         ; get some entities
  37.       (progn
  38.          (setq sl (sslength ss)) ; get the number of entities in ss
  39.          (initget 1 "X Y Z")
  40.          (setq ax (getkword "\nAxis (X, Y, or Z): "))
  41.          (initget 1)
  42.          (setq v  (getreal  "\nRotation angle: "))
  43.          (initget (+ 1 16))
  44.          (setq bp (getpoint "\nBase point: "))
  45.       )
  46.    )
  47.    (while (< n sl)
  48.       (setq el (entget (ssname ss n)))
  49.       (cond ((= (cdr (assoc 0 el)) "3DLINE")
  50.              (setq el (subst (cons 10 (rotate ax v bp (cdr (assoc 10 el))))
  51.                              (assoc 10 el) 
  52.                              el
  53.                       )
  54.              )
  55.              (setq el (subst (cons 11 (rotate ax v bp (cdr (assoc 11 el))))
  56.                              (assoc 11 el)
  57.                              el
  58.                       )
  59.              )
  60.              (entmod el)
  61.             )
  62.             ((= (cdr (assoc 0 el)) "3DFACE")
  63.              (setq el (subst (cons 10 (rotate ax v bp (cdr (assoc 10 el)))) 
  64.                              (assoc 10 el) 
  65.                              el
  66.                       )
  67.              )
  68.              (setq el (subst (cons 11 (rotate ax v bp (cdr (assoc 11 el)))) 
  69.                              (assoc 11 el) 
  70.                              el
  71.                       )
  72.              )
  73.              (setq el (subst (cons 12 (rotate ax v bp (cdr (assoc 12 el)))) 
  74.                              (assoc 12 el) 
  75.                              el
  76.                       )
  77.              )
  78.              (if (assoc 13 el)
  79.                 (setq el (subst (cons 13 (rotate ax v bp (cdr (assoc 13 el)))) 
  80.                                 (assoc 13 el) 
  81.                                 el
  82.                          )
  83.                 )
  84.              )
  85.              (entmod el)
  86.             )
  87.             (T nil)
  88.       )
  89.       (setq n (1+ n))
  90.    )
  91.    (princ)                       ; exit quietly
  92. )
  93.